--  ------------------------------------------------------------------------
--  @File: part.adb
--
--  @Project: liberAda
--  @Author: Markus Knauss, Julian Trischler
--  @Created: 2009-11-17
--  @Version: 1.0
--
--  @Description:
--    For detailed description (@see: part.ads).
--
--  @Modifications:
--    +2009-11-17 MK: Initial release
--    +2011-04-14 JT: Added title, level and anchor handling
with Ada.Unchecked_Deallocation;

package body Part is

   --  ----------------------------------------------------------------------
   --  @Function: Create
   function Create return Part_Type is
   begin
      return new Part_Record_Type;
   end Create;

   function Create
     (Anchor : in String;
      Title  : in String;
      Level  : in Level_Type) return Part.Part_Type is
      This : Part_Type := Create;
   begin
      Set_Anchor (This, Anchor);
      Set_Title (This, Title, Level);
      return This;
   end Create;

   --  ----------------------------------------------------------------------
   --  @Function: Exists
   function Exists (Part : in Part_Type) return Boolean is
   begin
      return Part /= null;
   end Exists;

   --  ----------------------------------------------------------------------
   --  @Procedure: Deallocate_Part
   procedure Deallocate_Part is new Ada.Unchecked_Deallocation
     (Object => Part_Record_Type,
      Name   => Part_Type);

   --  ----------------------------------------------------------------------
   --  @Procedure: Destroy
   procedure Destroy (Part : in out Part_Type) is
   begin
      if Part /= null then
         Deallocate_Part (Part);
         Part := null;
      end if;
   end Destroy;

   --  ----------------------------------------------------------------------
   --  @Procedure: Add_Attribute_Before
   procedure Add_Attribute_Before
     (Part : in out Part_Type;
      Attr : in     String) is
   begin
      pragma Assert (Part /= null);
      Part.Attr_Before.Append (ASU.To_Unbounded_String (Attr));
   end Add_Attribute_Before;

   --  ----------------------------------------------------------------------
   --  @Function: Has_Attributes_Before
   function Has_Attributes_Before (Part : in Part_Type) return Boolean is
   begin
      pragma Assert (Part /= null);
      return not Part.Attr_Before.Is_Empty;
   end Has_Attributes_Before;

   --  ----------------------------------------------------------------------
   --  @Function: Attributes_Before
   function Attributes_Before (Part : in Part_Type) return Attributes_Type is
   begin
      pragma Assert (Part /= null);
      return Vec_To_Arr (Part.Attr_Before);
   end Attributes_Before;

   --  ----------------------------------------------------------------------
   --  @Procedure: Add_Attribute_After
   procedure Add_Attribute_After
     (Part : in out Part_Type;
      Attr : in     String) is
   begin
      pragma Assert (Part /= null);
      Part.Attr_After.Append (ASU.To_Unbounded_String (Attr));
   end Add_Attribute_After;

   --  ----------------------------------------------------------------------
   --  @Function: Has_Attributes_After
   function Has_Attributes_After (Part : in Part_Type) return Boolean is
   begin
      pragma Assert (Part /= null);
      return not Part.Attr_After.Is_Empty;
   end Has_Attributes_After;

   --  ----------------------------------------------------------------------
   --  @Function: Attributes_After
   function Attributes_After (Part : in Part_Type) return Attributes_Type is
   begin
      pragma Assert (Part /= null);
      return Vec_To_Arr (Part.Attr_After);
   end Attributes_After;

   --  ----------------------------------------------------------------------
   --  @Procedure: Set_Value
   procedure Set_Value
     (Part  : in out Part_Type;
      Value : in     String) is
   begin
      pragma Assert (Part /= null);
      Part.Value := ASU.To_Unbounded_String (Value);
   end Set_Value;

   --  ----------------------------------------------------------------------
   --  @Function: Value
   function Value (Part : in Part_Type) return String is
   begin
      pragma Assert (Part /= null);
      return ASU.To_String (Part.Value);
   end Value;

   --  ----------------------------------------------------------------------
   --  @Procedure: Add_Part
   procedure Add_Part
     (Part     : in out Part_Type;
      Sub_Part : in     Part_Type) is
   begin
      pragma Assert (Part /= null);
      pragma Assert (Sub_Part /= null);
      Part.Parts.Append (Sub_Part);
   end Add_Part;

   --  ----------------------------------------------------------------------
   --  @Function: Has_Parts
   function Has_Parts (Part : in Part_Type) return Boolean is
   begin
      pragma Assert (Part /= null);
      return not Part.Parts.Is_Empty;
   end Has_Parts;

   --  ----------------------------------------------------------------------
   --  @Function: Parts
   function Parts (Part : in Part_Type) return Parts_Type is
   begin
      pragma Assert (Part /= null);
      return Vec_To_Arr (Part.Parts);
   end Parts;

   --  ----------------------------------------------------------------------
   --  @Function: Create_Part
   function Create_Part
     (Value : in String;
      Tag   : in String) return Part.Part_Type is

      New_Part : Part.Part_Type := Part.Create;
   begin
      Part.Add_Attribute_Before (New_Part, "<" & Tag & ">");
      Part.Set_Value (New_Part, Value);
      Part.Add_Attribute_After (New_Part, "</" & Tag & ">");
      return New_Part;
   end Create_Part;



   --  ----------------------------------------------------------------------
   --  @Function: Vec_To_Arr
   function Vec_To_Arr (Vec : Attr_Vectors.Vector) return Attributes_Type is
      Crsr : Attr_Vectors.Cursor := Vec.First;
      Idx  : Natural             := 1;
      Arr  : Attributes_Type (1 .. Natural (Vec.Length));
   begin
      pragma Assert (not Vec.Is_Empty);
      while Attr_Vectors.Has_Element (Crsr) loop
         Arr (Idx) := Attr_Vectors.Element (Crsr);
         Crsr      := Attr_Vectors.Next (Crsr);
         Idx       := Idx + 1;
      end loop;
      return Arr;
   end Vec_To_Arr;

   --  ----------------------------------------------------------------------
   --  @Function: Vec_To_Arr
   function Vec_To_Arr (Vec : Part_Vectors.Vector) return Parts_Type is
      Crsr : Part_Vectors.Cursor := Vec.First;
      Idx  : Natural             := 1;
      Part : Parts_Type (1 .. Natural (Vec.Length));
   begin
      pragma Assert (not Vec.Is_Empty);
      while Part_Vectors.Has_Element (Crsr) loop
         Part (Idx) := Part_Vectors.Element (Crsr);
         Crsr       := Part_Vectors.Next (Crsr);
         Idx        := Idx + 1;
      end loop;
      return Part;
   end Vec_To_Arr;

   --  ----------------------------------------------------------------------
   --  @Function: Anchor
   function Anchor (Part : in Part_Type) return String is
   begin
      pragma Assert (Part /= null);
      return ASU.To_String (Part.Anchor);
   end Anchor;

   --  ----------------------------------------------------------------------
   --  @Function: Has_Anchor
   function Has_Anchor (Part : in Part_Type) return Boolean is
      use type ASU.Unbounded_String;
   begin
      pragma Assert (Part /= null);
      return Part.Anchor /= ASU.Null_Unbounded_String;
   end Has_Anchor;

   --  ----------------------------------------------------------------------
   --  @Function: Set_Anchor
   procedure Set_Anchor (Part : in out Part_Type; Anchor : in String) is
   begin
      pragma Assert (Part /= null);
      Part.Anchor := ASU.To_Unbounded_String (Anchor);
   end Set_Anchor;

   --  ----------------------------------------------------------------------
   --  @Function: Title
   function Title (Part : in Part_Type) return String is
   begin
      pragma Assert (Part /= null);
      return ASU.To_String (Part.Title);
   end Title;

   --  ----------------------------------------------------------------------
   --  @Function: Has_Title
   function Has_Title (Part : in Part_Type) return Boolean is
      use type ASU.Unbounded_String;
   begin
      pragma Assert (Part /= null);
      return Part.Title /= ASU.Null_Unbounded_String;
   end Has_Title;

   --  ----------------------------------------------------------------------
   --  @Function: Level
   function Level (Part : in Part_Type) return Level_Type is
   begin
      pragma Assert (Part /= null);
      return Part.Level;
   end Level;

   --  ----------------------------------------------------------------------
   --  @Function: Set_Title
   procedure Set_Title
     (Part  : in out Part_Type;
      Title : in     String;
      Level : in     Level_Type) is
   begin
      pragma Assert (Part /= null);
      Part.Title := ASU.To_Unbounded_String (Title);
      Part.Level := Level;
   end Set_Title;

end Part;
